home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 21
/
Cream of the Crop 21 (Terry Blount) (October 1996).iso
/
program
/
srcbkvt.zip
/
LISTBOX.ASC
< prev
next >
Wrap
Text File
|
1996-07-08
|
7KB
|
308 lines
_Writing Delphi Components_
by William Stamatakis
Listing One
{ * Unit Name: tbillist.pas
* Author: William Stamatakis
* Note: Multi-Char Listbox Component (TBillListBox)
}
unit TBillist;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, FindDlg, Buttons, DsgnIntf, About;
type
TAboutProperty = class(TPropertyEditor)
public
procedure Edit; override;
function GetAttributes: TPropertyAttributes; override;
function GetValue: string; override;
end;
type TItemsProperty = class(TPropertyEditor)
public
procedure Edit; override;
function GetAttributes: TPropertyAttributes; override;
function GetValue: string; override;
end;
type
TBillListBox = class(TListBox)
private
dlgFind: TdlgFind;
FAutoSearch: Boolean;
FAbout: ShortInt;
protected
procedure KeyPress(var Key: Char); override;
public
procedure FindItemDlg(const SearchItem: string);
function SearchList(Item: PChar): Integer;
procedure SetCurrentIndex( CurrIndex: LongInt);
published
property AutoSearch: Boolean read FAutoSearch write FAutoSearch
default False;
property About: ShortInt read FAbout write FAbout;
end;
var
CurrentIndex: LongInt;
procedure Register;
implementation
uses Listdlg;
{TAboutProperty Methods.}
procedure TAboutProperty.Edit;
var
dlgAbout: TAboutbox;
begin
dlgAbout := TAboutbox.Create(Application); dlgAbout.ShowModal;
end;
function TAboutProperty.GetAttributes: TPropertyAttributes;
begin
Result := [paDialog, paReadOnly];
end;
function TAboutProperty.GetValue: string;
begin
Result := 'About Listbox Gadget...';
end;
{TItemsProperty Methods.}
procedure TItemsProperty.Edit;
var
dlgEditor: TListEditor;
objListBox: TBillListBox;
begin
try
objListBox := (self.GetComponent(0) as TBillListBox);
dlgEditor := TListEditor.Create(Application);
dlgEditor.SetReferenceTo(objListBox);
dlgEditor.lstItems.Clear;
dlgEditor.lstItems.Items.AddStrings(objListBox.Items);
dlgEditor.ShowModal;
finally
dlgEditor.Free;
end;
end;
function TItemsProperty.GetAttributes: TPropertyAttributes;
begin
Result := [paDialog, paReadOnly];
end;
function TItemsProperty.GetValue: string;
begin
Result := 'Click to add/modify items...';
end;
{TBillListBox Methods.}
procedure TBillListBox.FindItemDlg(const SearchItem: string);
begin
try
dlgFind := TdlgFind.Create(self);
dlgFind.Top := self.Parent.Top + self.Top;
dlgFind.Left := self.Parent.Left + self.Left;
dlgFind.edtFind.Text := SearchItem;
dlgFind.edtFind.SelStart := 1;
dlgFind.edtFind.AutoSelect:= False;
dlgFind.ShowModal;
finally
dlgFind.Free;
end;
end;
function TBillListBox.SearchList(Item: PChar): Integer;
var
ItemFound: LongInt;
begin ItemFound := SendMessage(Handle,
LB_FINDSTRING, CurrentIndex, LongInt(Item));
if ItemFound = LB_ERR then
begin
CurrentIndex := 0;
MessageDlgPos('Item not Found.', mtWarning, [mbOK],
0, dlgFind.Left + 75, dlgFind.Top);
end
else
ItemIndex := ItemFound;
CurrentIndex := ItemFound;
Result := ItemFound;
end;
procedure TBillListBox.SetCurrentIndex(CurrIndex: LongInt);
begin
CurrentIndex := CurrIndex;
end;
procedure TBillListBox.KeyPress(var Key: Char);
begin
{ Activate AutoSearch Dialog if the the AutoSearch property is set to True and
the Esc key and the Enter key have not been pressed. }
if (AutoSearch) then
begin
if ( (Key <> Chr(27)) and (Key <> Chr(13)) ) then
begin
{ Activate Listbox AutoSearch Dialog }
self.FindItemDlg(Key);
{ Disable Listbox KeyPress event by setting Key := null }
Key := #0;
end;
end
else
{ Do default bahavior}
inherited KeyPress(Key);
end;
procedure Register;
begin
RegisterComponents('Samples', [TBillListBox]);
RegisterPropertyEditor(TypeInfo(ShortInt), TBillListBox, 'About',
TAboutProperty);
RegisterPropertyEditor(TypeInfo(TStrings), TBillListBox, 'Items',
TItemsProperty);
end;
initialization
CurrentIndex := 0;
end.
Listing Two
{ * Unit Name: finddlg.pas
* Author: William Stamatakis
* Note: Search List Dialog for Multi-Char Listbox Component (TdlgFind)
}
unit Finddlg;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, Buttons;
type
TdlgFind = class(TForm)
edtFind: TEdit;
Label1: TLabel;
btnFindNext: TBitBtn;
btnClose: TBitBtn;
procedure ButtonsClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
dlgFind: TdlgFind;
implementation
uses Tbillist;
{$R *.DFM}
procedure TdlgFind.ButtonsClick(Sender: TObject);
var
strFind: string;
pFind: PChar;
begin
if Sender = btnClose then
begin
(Owner as TBillListBox).SetCurrentIndex(0);
Close;
end
else
begin
strFind := edtFind.Text;
pFind := @strFind;
StrPCopy(pFind, strFind);
(Owner as TBillListBox).SearchList(pFind);
end;
end;
end.
Example 1:
(a)
type TBillListBox = class(TListBox)
(b)
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, FindDlg, Buttons, DsgnIntf, About;
(c)
published
property AutoSearch: Boolean read FAutoSearch write FAutoSearch default False;
(d)
protected
procedure KeyPress(var Key: Char); override;
...
procedure TBillListBox.KeyPress(var Key: Char);
begin
{ Activate AutoSearch Dialog if the AutoSearch property is set to True and
the Esc key and the Enter key have not been pressed. }
if (AutoSearch) then
begin
if ( (Key <> Chr(27)) and (Key <> Chr(13)) ) then
begin
{ Activate Listbox AutoSearch Dialog }
self.FindItemDlg(Key);
{ Disable Listbox KeyPress event by setting Key := null }
Key := #0;
end;
end
else
{ Do default bahavior}
inherited KeyPress(Key);
end;
Example 2:
(a)
(Owner as TBillListBox).SearchList(pFind);
(b)
ItemFound := SendMessage(Handle, LB_FINDSTRING, CurrentIndex, LongInt(Item));
(c)
public
procedure FindItemDlg(const SearchItem: string);
procedure SearchList(Item: PChar);
procedure SetCurrentIndex( CurrIndex: LongInt);
Example 3:
(a)
type
TItemsProperty = class(TPropertyEditor)
public
procedure Edit; override;
function GetAttributes: TPropertyAttributes; override;
function GetValue: string; override;
end;
(b)
function TItemsProperty.GetAttributes: TPropertyAttributes;
begin
Result := [paDialog, paReadOnly];
end;
(c)
function TItemsProperty.GetValue: string;
begin
Result := 'Click to add/modify items...';
end;
(d)
RegisterPropertyEditor(TypeInfo(TStrings), TBillListBox, 'Items',TItemsProperty);
(e)
RegisterComponents('Samples', [TBillListBox]);